home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / WASTE 1.1a4 / Demo Source / LongControls.p < prev    next >
Encoding:
Text File  |  1994-01-04  |  5.0 KB  |  209 lines  |  [TEXT/PJMM]
  1. unit LongControls;
  2.  
  3. { WASTE DEMO PROJECT: }
  4. { Macintosh Controls with Long Values }
  5.  
  6. { Copyright © 1993-1994 Merzwaren }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.  
  11. { creation and destruction }
  12.  
  13.     function LCAttach (hControl: ControlHandle): OSErr;
  14.     procedure LCDetach (hControl: ControlHandle);
  15.  
  16. { setting variables }
  17.  
  18.     procedure LCSetValue (hControl: ControlHandle;
  19.                                     value: LongInt);
  20.     procedure LCSetMin (hControl: ControlHandle;
  21.                                     min: LongInt);
  22.     procedure LCSetMax (hControl: ControlHandle;
  23.                                     max: LongInt);
  24.  
  25. { getting variables }
  26.  
  27.     function LCGetValue (hControl: ControlHandle): LongInt;
  28.     function LCGetMin (hControl: ControlHandle): LongInt;
  29.     function LCGetMax (hControl: ControlHandle): LongInt;
  30.  
  31. { synchronizing long settings with control (short) settings }
  32.  
  33.     procedure LCSynch (hControl: ControlHandle);
  34.  
  35. implementation
  36.     uses
  37.         FixMath;
  38.  
  39. { LongControls private constants and data types }
  40.  
  41.     const
  42.  
  43.         kMaxShort = $7FFF;            { maximum signed short integer }
  44.         kMinShort = $8000;            { minimum signed short integer }
  45.  
  46.     type
  47.  
  48. { long control auxiliary record used for keeping long settings }
  49. { a handle to this record is stored in the contrlRfCon field of the control record }
  50.  
  51.         LCAuxRec = record
  52.                 value: LongInt;                { long value }
  53.                 min: LongInt;                { long min }
  54.                 max: LongInt;                { long max }
  55.             end;  { LCAuxRec }
  56.         LCAuxPtr = ^LCAuxRec;
  57.         LCAuxHandle = ^LCAuxPtr;
  58.  
  59.     function LCAttach (hControl: ControlHandle): OSErr;
  60.         var
  61.             aux: Handle;
  62.             pControl: ControlPtr;
  63.             pAux: LCAuxPtr;
  64.     begin
  65.         LCAttach := noErr;
  66.  
  67. { allocate the auxiliary record that will hold long settings }
  68.         aux := NewHandleClear(SizeOf(LCAuxRec));
  69.         if (aux = nil) then
  70.             begin
  71.                 LCAttach := MemError;
  72.                 Exit(LCAttach);
  73.             end;
  74.  
  75. { store a handle to the auxiliary record in the contrlRfCon field }
  76.         pControl := hControl^;
  77.         pControl^.contrlRfCon := LongInt(aux);
  78.  
  79. { copy current control settings into the auxiliary record }
  80.         pAux := LCAuxHandle(aux)^;
  81.         pAux^.value := pControl^.contrlValue;
  82.         pAux^.min := pControl^.contrlMin;
  83.         pAux^.max := pControl^.contrlMax;
  84.  
  85.     end;  { LCAttach }
  86.  
  87.     procedure LCDetach (hControl: ControlHandle);
  88.         var
  89.             pControl: ControlPtr;
  90.             aux: Handle;
  91.     begin
  92.         pControl := hControl^;
  93.         aux := Handle(pControl^.contrlRfCon);
  94.         if (aux <> nil) then
  95.             begin
  96.                 pControl^.contrlRfCon := 0;
  97.                 DisposHandle(aux);
  98.             end
  99.     end;  { LCDispose }
  100.  
  101.     procedure LCSetValue (hControl: ControlHandle;
  102.                                     value: LongInt);
  103.         var
  104.             pControl: ControlPtr;
  105.             pAux: LCAuxPtr;
  106.             thumb: Integer;
  107.     begin
  108.         pControl := hControl^;
  109.         pAux := LCAuxHandle(pControl^.contrlRfCon)^;
  110.  
  111. { make sure value is in the range min..max }
  112.         if (value < pAux^.min) then
  113.             value := pAux^.min;
  114.         if (value > pAux^.max) then
  115.             value := pAux^.max;
  116.  
  117. { save value in auxiliary record }
  118.         pAux^.value := value;
  119.  
  120. { calculate new thumb position }
  121.         thumb := pControl^.contrlMin + FixRound(FixMul(FixDiv(value - pAux^.min, pAux^.max - pAux^.min), BSL(pControl^.contrlMax - pControl^.contrlMin, 16)));
  122.  
  123. { do nothing if the thumb position hasn't changed }
  124.         if (thumb <> pControl^.contrlValue) then
  125.             SetCtlValue(hControl, thumb);
  126.  
  127.     end;  { LCSetValue }
  128.  
  129.     procedure LCSetMin (hControl: ControlHandle;
  130.                                     min: LongInt);
  131.         var
  132.             pControl: ControlPtr;
  133.             pAux: LCAuxPtr;
  134.     begin
  135.         pControl := hControl^;
  136.         pAux := LCAuxHandle(pControl^.contrlRfCon)^;
  137.  
  138. { make sure min is less than or equal to max }
  139.         if (min > pAux^.max) then
  140.             min := pAux^.max;
  141.  
  142. { save min in auxiliary record }
  143.         pAux^.min := min;
  144.  
  145. { set contrlMin field to min or kMinShort, whichever is greater }
  146.         if (min < kMinShort) then
  147.             min := kMinShort;
  148.         pControl^.contrlMin := min;
  149.  
  150. { reset value }
  151.         LCSetValue(hControl, pAux^.value);
  152.  
  153.     end;  { LCSetMin }
  154.  
  155.     procedure LCSetMax (hControl: ControlHandle;
  156.                                     max: LongInt);
  157.         var
  158.             pControl: ControlPtr;
  159.             pAux: LCAuxPtr;
  160.     begin
  161.         pControl := hControl^;
  162.         pAux := LCAuxHandle(pControl^.contrlRfCon)^;
  163.  
  164. { make sure max is greater than or equal to min }
  165.         if (max < pAux^.min) then
  166.             max := pAux^.min;
  167.  
  168. { save max in auxiliary record }
  169.         pAux^.max := max;
  170.  
  171. { set contrlMax field to max or kMaxShort, whichever is less }
  172.         if (max > kMaxShort) then
  173.             max := kMaxShort;
  174.         pControl^.contrlMax := max;
  175.  
  176. { reset value }
  177.         LCSetValue(hControl, pAux^.value);
  178.  
  179.     end;  { LCSetMax }
  180.  
  181.     function LCGetValue (hControl: ControlHandle): LongInt;
  182.     begin
  183.         LCGetValue := LCAuxHandle(hControl^^.contrlRfCon)^^.value;
  184.     end;  { LCGetValue }
  185.  
  186.     function LCGetMin (hControl: ControlHandle): LongInt;
  187.     begin
  188.         LCGetMin := LCAuxHandle(hControl^^.contrlRfCon)^^.min;
  189.     end;  { LCGetMin }
  190.  
  191.     function LCGetMax (hControl: ControlHandle): LongInt;
  192.     begin
  193.         LCGetMax := LCAuxHandle(hControl^^.contrlRfCon)^^.max;
  194.     end;  { LCGetMax }
  195.  
  196.     procedure LCSynch (hControl: ControlHandle);
  197.         var
  198.             pControl: ControlPtr;
  199.             pAux: LCAuxPtr;
  200.     begin
  201.         pControl := hControl^;
  202.         pAux := LCAuxHandle(pControl^.contrlRfCon)^;
  203.  
  204. { calculate new long value }
  205.         pAux^.value := pAux^.min + FixMul(FixRatio(pControl^.contrlValue - pControl^.contrlMin, pControl^.contrlMax - pControl^.contrlMin), pAux^.max - pAux^.min);
  206.  
  207.     end;  { LCSynch }
  208.  
  209. end.